home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / comm2 / ftp-mail.lha / FTP-Mail / ftp-mail.rexx < prev    next >
OS/2 REXX Batch file  |  1995-11-26  |  37KB  |  1,128 lines
  1. /* ftp-mail-server
  2.    © 1995 by Alexander Aulbach, see DISCLAIMER!
  3.  
  4.    This program reads the "mail."-files in the same directory;
  5.    checks for double-calls via semaphore-file opened for writing;
  6.    analyzes the mail; Double-Syntax-Check;
  7.    Output mails wanted from the user.
  8.  
  9. V 1.09, 11.10.95: LISTALL-commands, new version of CD (now checks *), GET
  10. now recognises files, which have been sent just before, sending Logfile to
  11. ftp-postmaster.
  12.  
  13. V 2.0, 17.10.95: Fixed some small bugs remained, more comments in Source,
  14. ParseRFCAddress changed (only strips comments), some cosmetics.
  15.  
  16. V 2.01, 1.11.95: Last changes.
  17.  
  18. */
  19.  
  20. OPTIONS RESULTS
  21. ADDRESS COMMAND
  22.  
  23.  
  24. SIGNAL ON SYNTAX
  25. SIGNAL ON ERROR
  26. SIGNAL ON IOERR
  27. /*SIGNAL ON NOVALUE*/
  28. SIGNAL ON BREAK_C
  29. SIGNAL ON BREAK_D
  30. SIGNAL ON BREAK_E
  31. SIGNAL ON BREAK_F
  32. SIGNAL ON HALT
  33.  
  34.  
  35. /* Read arguments for 1st command */
  36. ARG firstcommand
  37.  
  38. /* Semaphore */
  39. i=200
  40. DO WHILE ~OPEN('sema',"T:ftp-mail.semaphore","W") & i>0
  41.   ADDRESS COMMAND "WAIT 1"
  42.   i=i-1
  43. END
  44. IF i<=0 THEN DO
  45.   SAY "Waiting aborted.."
  46.   EXIT 10
  47. END
  48.  
  49.  
  50. /* My standard ARexx-Header - reads program-path etc. */
  51. PARSE SOURCE x
  52. PARSE VAR x . . . path .
  53. version     = '$VER: Ftp-Mail 2.01 (11-Oct-1995)
  54. '
  55. progname    = WORD(version,2)
  56. /*path        = PRAGMA('D')*/
  57. author  = 'Alexander Aulbach'
  58. starttime =DATE() TIME()
  59. CALL TIME("R")
  60.  
  61. x=LASTPOS('/',path)
  62. IF x=0 THEN DO
  63.   x=LASTPOS(':',path)
  64.   IF x=0 THEN DO
  65.     SAY 'Programpath not ok!'
  66.     EXIT 10
  67.   END
  68. END
  69. path=DELSTR(path,x+1)
  70. CALL PRAGMA("D",path)
  71. CALL PRAGMA("P",-10)
  72.  
  73.  
  74. IF ~SHOW('LIB','rexxsupport.library') THEN DO
  75.   IF ~ADDLIB('rexxsupport.library',0,-30,0) THEN DO
  76.     errortxt='Could not open "rexxsupport.library"!'
  77.     SIGNAL LEAVE
  78.   END
  79. END
  80.  
  81. /* Read alias-file */
  82. k=1
  83. IF EXISTS("config/ftp-aliases.config") THEN DO
  84.   IF ~OPEN('fp',"config/ftp-aliases.config","R") THEN DO
  85.     errortxt='Could not open "config/ftp-aliases.config"!'
  86.     SIGNAL LEAVE
  87.   END
  88.   DO WHILE ~EOF('fp')
  89.     line=STRIP(TRANSLATE(READLN('fp')," ","09"x),"B")
  90.     IF LEFT(line,1)~="#" & line~="" THEN DO
  91.       alias.k=UPPER(WORD(line,1))" "SUBWORD(line,2)
  92.       k=k+1
  93.     END
  94.   END
  95.   CALL CLOSE('fp')
  96. END
  97.  
  98.  
  99. /* Read maxtransfer-file */
  100. IF EXISTS("config/ftp-maxtransfer.config") THEN DO
  101.   IF ~OPEN('fp',"config/ftp-maxtransfer.config","R") THEN DO
  102.     errortxt='Could not open "config/ftp-maxtransfer.config"!'
  103.     SIGNAL LEAVE
  104.   END
  105.   DO WHILE ~EOF('fp')
  106.     line=STRIP(TRANSLATE(READLN('fp')," ","09"x),"B")
  107.     IF LEFT(line,1)~="#" & line~="" THEN DO
  108.       IF DATATYPE(line)="NUM" THEN maxtransfer=line
  109.     END
  110.   END
  111.   CALL CLOSE('fp')
  112. END
  113. IF SYMBOL("maxtransfer")="LIT" THEN maxtransfer=0
  114.  
  115. SAY
  116. SAY "################################################################"
  117. SAY "-- START "progname" at "starttime
  118.  
  119. /* Read directory-contents (for Help-Files) */
  120. r=1
  121. tmpdir=UPPER(showdir(path"tmp/","FILES"))
  122.  
  123. x=UPPER(showdir(path,"FILES"))
  124. dir=""
  125. /* sort words in string alphabetical */
  126. DO i=1 TO WORDS(x)-1
  127.   j=WORD(x,1); l=1
  128.   DO k=2 TO WORDS(x)
  129.     IF j>WORD(x,k) THEN DO
  130.       j=WORD(x,k); l=k
  131.     END
  132.   END
  133.   dir=dir" "j
  134.   x=DELWORD(x,l,1)
  135. END
  136.  
  137. /* Read directory-contents (for Config-Files) */
  138. x=UPPER(showdir(path"config/","FILES"))
  139. /* sort words in string alphabetical */
  140. DO i=1 TO WORDS(x)-1
  141.   j=WORD(x,1); l=1
  142.   DO k=2 TO WORDS(x)
  143.     IF j>WORD(x,k) THEN DO
  144.       j=WORD(x,k); l=k
  145.     END
  146.   END
  147.   dir=dir" CONFIG/"j
  148.   x=DELWORD(x,l,1)
  149. END
  150.  
  151.  
  152.  
  153. /***************
  154.                        Mail-Main-Loop
  155. ***************/
  156. DO mwordno=1 TO WORDS(tmpdir)
  157.   mword=WORD(tmpdir,mwordno)
  158.   IF LEFT(mword,5)~='MAIL.' THEN ITERATE mwordno
  159.  
  160.   mailstarttime=DATE() TIME()
  161.   SAY
  162.   SAY "   ----"
  163.   SAY "Found "mword
  164.   DROP replace.
  165.   DROP cmdline.
  166.   DROP origline.
  167.   senthelp=""        /* just sent helpfiles of a session */
  168.   sentget=""         /* sent files */
  169.   origline.1=" MODE uuencode | # Default 1st command! #"
  170.   IF firstcommand~="" THEN DO                /* put args in 1st command */
  171.     origline.1=origline.1||" | "firstcommand
  172.   END
  173.   cline=1
  174.   nologfile=0
  175.   nofilehelp=0
  176.   date="???"               /* filled from the Mail */
  177.   msid="???"
  178.   repl="???"
  179.   from="???"
  180.  
  181.   xuplpath=""             /* for PUT-command */
  182.   xname=""
  183.   xcomment=""
  184.   xlength=0
  185.  
  186.   /* Open the Mail */
  187.   IF ~OPEN('fp',"tmp/"mword,"R") THEN DO
  188.     errortxt='Could not open "tmp/'mword'"!'
  189.     SIGNAL LEAVE
  190.   END
  191.  
  192.   readnext=1;
  193.   line=origline.1; oldline=line
  194.   k=1
  195.   nooflines=0
  196. /***************
  197.                        1st Parse-Mainloop
  198. ***************/
  199.   DO WHILE ~EOF('fp') | k~=0
  200.     IF readnext THEN DO           /* Checking for command-delimiters */
  201.       IF k~=0 THEN DO
  202.         line=SUBSTR(oldline,k+1)
  203.         k=INDEX(line,"|")
  204.         IF k=0 THEN origline.cline=line
  205.         ELSE origline.cline=LEFT(line,INDEX(line,"|")-1)
  206.       END
  207.       ELSE DO
  208.         /* Translate TAB's to Space */
  209.         line=STRIP(TRANSLATE(READLN('fp')," |","09"x";"),"B")
  210.         origline.cline=line
  211.         nooflines=nooflines+1
  212.       END
  213.     END
  214.     readnext=1
  215.  
  216.     oldline=line
  217.     k=INDEX(line,"|")
  218.     IF k~=0 THEN line=LEFT(line,k-1)
  219.  
  220.     wd=UPPER(WORD(line,1)); l=SUBWORD(line,2)
  221.     SELECT
  222.       WHEN wd="" | LEFT(wd,1)="#" | LENGTH(wd)=0 THEN ITERATE
  223.       WHEN wd="NOLOGFILE" THEN nologfile=1
  224.       WHEN wd="NOFILEHELP" THEN nofilehelp=1
  225.       WHEN wd="DATE:" & date="???" THEN date=l
  226.       WHEN wd="MESSAGE-ID:" & msid="???" THEN msid=l
  227.       WHEN wd="REPLY-TO:" THEN repl=l
  228.       WHEN wd="FROM:" THEN from=l
  229.  
  230.       WHEN wd="X-PATH:" & xuplpath="" THEN xuplpath=l
  231.       WHEN wd="X-NAME:" & xname=""           THEN xname=l
  232.       WHEN wd="X-COMMENT:" & xcomment=""     THEN xcomment=l
  233.       WHEN wd="X-LENGTH:" & xlength=0        THEN DO
  234.         l=WORD(l,1)
  235.         IF DATATYPE(l)="NUM" THEN xlength=l
  236.       END
  237.  
  238.       WHEN wd="END" THEN DO
  239.         CALL SEEK('fp',0,"E")
  240.         oldline="" ; readnext=1   /* the mail is declared as read! */
  241.       END
  242.  
  243.       WHEN wd="HELP" THEN DO
  244.         l=UPPER(l)
  245.         IF l="" THEN l="HELP.DOC"
  246.         IF RIGHT(l,4)~=".DOC" & RIGHT(l,4)~=".DOK" & RIGHT(l,7)~=".CONFIG" & RIGHT(l,5)~=".LIST" THEN l=l||".DOC"
  247.         IF LEFT(l,7)~="CONFIG/" & RIGHT(l,7)=".CONFIG" THEN l="CONFIG/"||l
  248.         CALL AddCommand("HELP "TRANSLATE(l,"-",':'))
  249.       END
  250.       WHEN wd="MODE" THEN DO
  251.         CALL AddCommand("MODE "l)
  252.       END
  253.       WHEN wd="CD" THEN DO
  254.         CALL AddCommand("CD "l)
  255.       END
  256.       WHEN wd="DIR" | wd="LS" | wd="LIST" THEN DO
  257.         /* make a cd-command, if found a pathname */
  258.         IF INDEX(l,":")~=0 THEN DO
  259.           CALL AddCommand("CD "l)
  260.           origline.cline=line
  261.         END
  262.         CALL AddCommand(wd)
  263.       END
  264.       WHEN wd="DIRALL" | wd="LSALL" | wd="LISTALL" THEN DO
  265.         /* make a cd-command, if found a pathname */
  266.         IF INDEX(l,":")~=0 THEN DO
  267.           CALL AddCommand("CD "l)
  268.           origline.cline=line
  269.         END
  270.         CALL AddCommand(DELSTR(wd,LENGTH(wd)-2)||" "||"ALL")
  271.       END
  272.       WHEN wd="SHOWDIRS" THEN DO
  273.         /* make a cd-command, if found a pathname */
  274.         IF INDEX(l,":")~=0 THEN DO
  275.           CALL AddCommand("CD "l)
  276.           origline.cline=line
  277.         END
  278.         CALL AddCommand(wd)
  279.       END
  280.       WHEN wd="PUT" THEN DO
  281.         CALL AddCommand("PUT")
  282.         CALL SEEK('fp',0,"E")
  283.         oldline="" ; readnext=1
  284.         /* After the PUT-command the mail is declared as read! */
  285.       END
  286.       WHEN wd="GET" THEN DO
  287.         /* make a cd-command, if found a pathname */
  288.         IF INDEX(l,":")~=0 THEN DO
  289.           r=LASTPOS("/",l)
  290.           IF r=0 THEN r=LASTPOS(":",l)
  291.           k=LEFT(l,r)
  292.           l=SUBSTR(l,r+1)
  293.           CALL AddCommand("CD "k)
  294.           origline.cline=line
  295.         END
  296.         CALL AddCommand("GET "l)
  297.       END
  298.       OTHERWISE                     /* Check if alias an try again! */
  299.         k=1
  300.         DO WHILE SYMBOL("alias.k")="VAR"
  301.           IF wd=WORD(alias.k,1) THEN DO
  302.              IF INDEX(oldline,"|")~=0 THEN l=l||SUBSTR(oldline,INDEX(oldline,"|"))
  303.              line=STRIP(TRANSLATE(SUBWORD(alias.k,2)" "l," ","09"x),"B")
  304.              replace.r='   "'wd' 'l'" -> "'line'"'
  305.              wd=UPPER(WORD(line,1)); l=SUBWORD(line,2)
  306.              readnext=0
  307.              r=r+1
  308.           END
  309.           k=k+1
  310.         END
  311.     END
  312.     k=INDEX(oldline,"|")
  313.   END
  314.  
  315.   CALL CLOSE('fp')
  316.  
  317.   /* Check sendback */
  318.   IF repl~="???" THEN sendback=repl
  319.   ELSE sendback=from
  320.   IF sendback="???" THEN DO
  321.     SAY "ATTENTION! THIS MAIL IS NOT VALID! FROM: is not defined!"
  322.     sendback="ftp-postmaster"
  323.   END
  324.  
  325.   sendback=ParseRFCAddress(sendback)
  326.  
  327.   IF date="???" THEN DO
  328.     SAY "ATTENTION! THIS MAIL IS NOT VALID! DATE: is not defined!"
  329.     sendback=sendback", ftp-postmaster"
  330.   END
  331.  
  332.  
  333.   /* Which level has sendback? */
  334.   ulevel=0
  335.   DO k=0 WHILE EXISTS("config/ftp-domains-lvl"k".config")
  336.     IF ~OPEN('lvl',"config/ftp-domains-lvl"k".config","R") THEN DO
  337.       errortxt='Could not open "config/ftp-domains-lvl'k'.config"!'
  338.       SIGNAL LEAVE
  339.     END
  340.     DO WHILE ~EOF('lvl')
  341.       line=STRIP(TRANSLATE(READLN('lvl')," ","09"x),"B")
  342.       IF LEFT(line,1)~="#" & line~="" THEN DO
  343.         IF INDEX(sendback,line)~=0 | line="*" THEN DO
  344.           ulevel=k
  345.         END
  346.       END
  347.     END
  348.     CALL CLOSE('lvl')
  349.   END
  350.  
  351.  
  352.   SAY "From: "from
  353.   SAY "Sendback to: "sendback
  354.   SAY "Message-Id: "msid
  355.   SAY "Date: "date
  356.   SAY "Userlevel: "ulevel
  357.  
  358.  
  359.   IF ~OPEN('fp',"tmp/logfile","W") THEN DO
  360.     errortxt='Could not open "logfile"!'
  361.     SIGNAL LEAVE
  362.   END
  363.  
  364.   logfileflag=1
  365.  
  366.   CALL WriteLog(">>> FTP-MAIL from "||from)
  367.   CALL WriteLog("  >>>  Length:" WORD(STATEF("tmp/"mword),2))
  368.   CALL WriteLog("  SEND BACK TO "sendback)
  369.  
  370.   CALL WRITELN('fp',"")
  371.   CALL WRITELN('fp',progname" : "version" by "author)
  372.   CALL WRITELN('fp',"")
  373.   CALL WRITELN('fp',"-- Start session:  "mailstarttime)
  374.   CALL WRITELN('fp',"")
  375.   CALL WRITELN('fp',"-- This is an automatically created logfile as a reply")
  376.   CALL WRITELN('fp',"   to your mail    "msid)
  377.   CALL WRITELN('fp',"   at              "date".")
  378.   CALL WRITELN('fp',"   Userlevel:      "ulevel)
  379.   CALL WRITELN('fp',"")
  380.   CALL WRITELN('fp',"------------------------------------------------")
  381.   CALL WRITELN('fp',"ORIGINAL MAIL AS RECEIVED BY THIS PROGRAM (comment-lines not included!):")
  382.   IF ~OPEN('p',"tmp/"mword,"R") THEN DO
  383.     errortxt='Could not open "tmp/'mword'"!'
  384.     SIGNAL LEAVE
  385.   END
  386.   DO k=1 WHILE ~EOF('p') & k<=nooflines+2
  387.     l=READLN('p')
  388.     IF LEFT(l,1)~="#" & l~="" THEN DO
  389.       CALL WRITELN('fp',RIGHT(k,LENGTH(nooflines))"> "l)
  390.     END
  391.   END
  392.   CALL CLOSE('p')
  393.   IF k-1>nooflines THEN CALL WRITELN('fp',"... aborting ... PUT or END-Command detected!")
  394.  
  395.   CALL WRITELN('fp',"------------------------------------------------")
  396.   CALL WRITELN('fp',"-- Total lines:    "nooflines" (including header)")
  397.   CALL WRITELN('fp',"   Commands found: "cline-2)
  398.   CALL WRITELN('fp',"")
  399.   CALL WRITELN('fp',"-- Replying to:    "sendback)
  400.   CALL WRITELN('fp',"")
  401.  
  402.   IF SYMBOL("replace.1")="VAR" THEN DO
  403.      CALL WRITELN('fp',"-- Found aliases - replacing:")
  404.      r=1
  405.      DO WHILE SYMBOL("replace.r")="VAR"
  406.        CALL WRITELN('fp',replace.r)
  407.        r=r+1
  408.      END
  409.      CALL WRITELN('fp',"")
  410.   END
  411.   CALL WRITELN('fp',"------------------------------------------------")
  412.   CALL WRITELN('fp',"-- Scanning for commands:")
  413.  
  414.  
  415.   cdpath="?"
  416.   cdpathstern=0
  417.   cline=1
  418. /***************
  419.                        2nd Parse-Mainloop
  420. ***************/
  421.   DO WHILE SYMBOL("cmdline.cline")="VAR"
  422.     CALL WRITELN('fp',"")
  423.     CALL WRITELN('fp','-- Command 'RIGHT(cline-1,3)'  ----  ("'origline.cline'")')
  424.     CALL WRITELN('fp','   -> Interpreted:     "'cmdline.cline'"')
  425.     SAY cline-1"  -------------------"
  426.     SAY origline.cline" ---> "cmdline.cline
  427.     wd=UPPER(WORD(cmdline.cline,1)); l=SUBWORD(cmdline.cline,2)
  428.     SELECT
  429. /***************
  430.  HELP
  431. ***************/
  432.       WHEN wd="HELP" THEN DO
  433.         IF EXISTS(l) THEN DO
  434.           IF INDEX(senthelp,UPPER(l))=0 THEN DO
  435.             CALL DELETE("tmp/tmpfile")
  436.             IF ~OPEN('thpf',"tmp/tmpfile","W") THEN DO
  437.               errortxt='Could not open "tmp/tmpfile"'
  438.               SIGNAL LEAVE
  439.             END
  440.  
  441.             IF ~OPEN('opf',l,"R") THEN DO
  442.               errortxt='Could not find "'l'"'
  443.               SIGNAL LEAVE
  444.             END
  445.             DO WHILE ~EOF('opf')
  446.               CALL WRITELN('thpf',READLN('opf'))
  447.             END
  448.             CALL CLOSE('opf')
  449.  
  450.             IF senthelp="" | nofilehelp THEN DO
  451.               CALL WRITELN('thpf',"")
  452.               CALL WRITELN('thpf',"-------------------------------------------------------------------------")
  453.               CALL WRITELN('thpf','Other available helpfiles (with command "HELP <filename>"):')
  454.               CALL WRITELN('thpf',"")
  455.               CALL WRITELN('thpf'," "LEFT("Name",49)RIGHT("Bytes",12)"   Days old")
  456.               CALL WRITELN('thpf'," "COPIES("-",49)"  "COPIES("-",10)"   --------")
  457.               DO k=1 TO WORDS(dir)
  458.                 j=WORD(dir,k)
  459.                 IF (RIGHT(j,4)=".DOC" | RIGHT(j,4)=".DOK" | RIGHT(j,7)=".CONFIG" | RIGHT(j,5)=".LIST") & LEFT(j,1)~="." THEN DO
  460.                   x=STATEF(j)
  461.                   y=DATE("I")-WORD(x,5)
  462.                   CALL WRITELN('thpf'," "LEFT(j,49)"  "RIGHT(WORD(x,2),10)"     "RIGHT(DATE("I")-WORD(x,5),5))
  463.                   IF j=l THEN CALL WRITELN('thpf'," ^^^^ This is the help-file, you got with this mail!")
  464.                   IF SUBWORD(x,8)~="" THEN CALL WRITELN('thpf',' ^^^^ 'SUBWORD(x,8))
  465.                 END
  466.               END
  467.               CALL WRITELN('thpf',"")
  468.               CALL WRITELN('thpf',"-------------------------------------------------------------------------")
  469.             END
  470.             CALL CLOSE('thpf')
  471.             CALL WRITELN('fp',"   -> Sending help-file "l)
  472.             SAY "Send HELP "l
  473.             CALL Shcmd('sendmail <tmp/tmpfile -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'ConvertQuote(sendback)'" -s "'ConvertQuote(wd' 'l)'" -raw')
  474.             CALL WriteLog("  HELP" l "  --  Length:" WORD(STATEF("tmp/tmpfile"),2))
  475.             CALL DELETE("tmp/tmpfile")
  476.             senthelp=senthelp" "UPPER(l)
  477.           END
  478.           ELSE CALL WRITELN('fp',"### This help: "l" has just been sent!")
  479.         END
  480.         ELSE DO
  481.              CALL WRITELN('fp',"### This help: "l" doesn't exist!")
  482.              CALL WRITELN('fp',"### Please use command HELP (sends a documentation of ftp-mail to you!)")
  483.              CALL WRITELN('fp',"### or use command HELPALL, which sends HELP and the config-files.")
  484.         END
  485.       END
  486. /***************
  487.  MODE
  488. ***************/
  489.       WHEN wd="MODE" THEN DO
  490.         IF ~OPEN('opf',"config/ftp-modes.config","R") THEN DO
  491.           errortxt='Could not find "config/ftp-modes.config"'
  492.           SIGNAL LEAVE
  493.         END
  494.         x=0
  495.         DO WHILE ~EOF('opf') & ~x
  496.           k=UPPER(STRIP(TRANSLATE(READLN('opf')," ","09"x),"B"))
  497.           IF LEFT(k,1)~="#" & k~="" THEN DO
  498.             IF UPPER(l)=WORD(k,1) THEN DO
  499.               mode=WORD(k,1)
  500.               modegetscript=WORD(k,2)
  501.               modeputscript=WORD(k,3)
  502.               SAY "Setting mode to "mode"  ("modegetscript", "modeputscript")"
  503.               x=1
  504.             END
  505.           END
  506.         END
  507.         CALL CLOSE('opf')
  508.  
  509.         IF ~x THEN DO
  510.           CALL WRITELN('fp',"### No such mode!!!")
  511.           CALL WRITELN('fp','### Please use command "MODES" for a list of available transfer modes!!!')
  512.           mode="UUENCODE"
  513.         END
  514.         CALL WRITELN('fp',"   -> Mode now: "mode)
  515.       END
  516. /***************
  517.  CD
  518. ***************/
  519.       WHEN wd="CD" THEN DO
  520.         IF l="" THEN DO
  521.           CALL WRITELN('fp',"### No empty paths allowed!")
  522.         END
  523.  
  524.         IF INDEX(l,"\")~=0 THEN DO
  525.           CALL WRITELN('fp',"### Character '\' not allowed!")
  526.           CALL WRITELN('fp',"### Format of Amiga paths: <device>:[<subdir>][/<subdir>[/...]")
  527.         END
  528.  
  529.         IF LEFT(l,1)=":" & INDEX(cdpath,":")~=0 THEN DO
  530.           l=LEFT(cdpath,INDEX(cdpath,":")-1)||l
  531.           CALL WRITELN('fp',"   -> Found relative pathname.")
  532.           CALL WRITELN('fp','      Path now: "'l'"  ...checking...')
  533.         END
  534.  
  535.         IF INDEX(l,":")=0 THEN DO
  536.           DO WHILE LEFT(l,1)="/"
  537.             IF RIGHT(l,1)="/" THEN r=LASTPOS("/",cdpath,LENGTH(cdpath)-1)
  538.             ELSE r=LASTPOS("/",cdpath)
  539.             IF r~=0 THEN DO
  540.               cdpath=DELSTR(cdpath,r+1)
  541.               CALL WRITELN('fp','   -> Found "/". Going up in directory tree.')
  542.               CALL WRITELN('fp','      Path now: "'cdpath'"  ...checking...')
  543.             END
  544.             ELSE DO
  545.               CALL WRITELN('fp',"### Cannot go up once more in directory tree!")
  546.               CALL WRITELN('fp',"### Format of Amiga paths: <device>:[<subdir>][/<subdir>[/...]")
  547.             END
  548.             l=SUBSTR(l,2)
  549.           END
  550.           IF l~="" THEN DO
  551.             cdpath=cdpath||l
  552.             CALL WRITELN('fp','   -> Found relative pathname "'l'" - adding to path.')
  553.           END
  554.           CALL WRITELN('fp','      Path now: "'cdpath'"  ...checking...')
  555.           l=cdpath
  556.           SAY l
  557.           cdpath="?"
  558.           cdpathstern=0
  559.         END
  560.  
  561.         IF RIGHT(l,1)~="/" THEN DO
  562.           IF RIGHT(l,1)~=":" THEN DO
  563.             l=l||"/"
  564.             /* CALL WRITELN('fp','   -> Add "/" to path, path is now "'l'"') */
  565.             SAY "CD "||l
  566.           END
  567.         END
  568.  
  569.         x=0
  570.         cdpathstern=0
  571.         DO r=0 WHILE r<=ulevel & ~x
  572.           SELECT
  573.             WHEN r=0 THEN pathname="config/ftp-paths.config"
  574.             OTHERWISE pathname="config/ftp-paths-"r".config"
  575.           END
  576.           IF EXISTS(pathname) | r=0 THEN DO
  577.             IF ~OPEN('pp',pathname,"R") THEN DO
  578.               errortxt='Could not open "'pathname'"!'
  579.               SIGNAL LEAVE
  580.             END
  581.             DO WHILE ~EOF('pp') & ~x
  582.               k=UPPER(STRIP(TRANSLATE(READLN('pp')," ","09"x),"B"))
  583.               IF LEFT(k,1)~="#" & k~="" THEN DO
  584.                 IF k=UPPER(l) THEN x=1
  585.                 IF RIGHT(k,1)="*" THEN DO
  586.                   SAY "Path found..."
  587.                   IF LEFT(UPPER(l),LENGTH(k)-1)=LEFT(k,LENGTH(k)-1) THEN x=1
  588.                   cdpathstern=1
  589.                   SAY "* found..."
  590.                 END
  591.               END
  592.             END
  593.             CALL CLOSE('pp')
  594.           END
  595.           ELSE DO
  596.             CALL WRITELN('fp','### Warning: Did not found file: "'pathname'"')
  597.           END
  598.         END
  599.         IF ~x THEN DO
  600.           CALL WRITELN('fp',"### This path is not allowed! Command not executed!")
  601.           CALL WRITELN('fp','### Use the command "PATHS" for a list of all valid paths!')
  602.         END
  603.         ELSE DO
  604.           cdpath=l
  605.           IF ~EXISTS(cdpath) THEN DO
  606.             CALL WRITELN('fp','### This path does not exist!')
  607.             CALL WRITELN('fp','### Please use command "PATHS", "SHOWDIR" or "DIRALL"')
  608.             CALL WRITELN('fp','### for a list of all Subdirs on this path!')
  609.             cdpath="?"
  610.             cdpathstern=0
  611.           END
  612.           SAY "CD "l
  613.         END
  614.         CALL WRITELN('fp','   -> Path now: "'cdpath'"')
  615.       END
  616. /***************
  617.  DIR LS LIST
  618. ***************/
  619.       WHEN wd="DIR" | wd="LS" | wd="LIST" THEN DO
  620.         IF cdpath~="?" THEN DO
  621.           CALL DELETE('tmp/tmplist')
  622.           IF UPPER(l)="ALL" & cdpathstern THEN m="ALL"
  623.           ELSE DO
  624.             IF UPPER(l)="ALL" & ~cdpathstern THEN DO
  625.               CALL WRITELN('fp',"### This path is not allowed to scan recursively.")
  626.               CALL WRITELN('fp',"### Scanning single instead. See command PATH!")
  627.               CALL Shcmd('Echo >tmp/tmplist "Path not allowed to scan recursivly, scanning single instead!*n"')
  628.             END
  629.             m=""
  630.           END
  631.           SELECT
  632.             WHEN wd="DIR"  THEN l="DIR >>tmp/tmplist "||m
  633.             WHEN wd="LS"   THEN l='LIST >>tmp/tmplist LFORMAT="%a %8b %9l %d %f%n*n/** %c ***/" '||m
  634.             WHEN wd="LIST" THEN l='LIST >>tmp/tmplist LFORMAT="%d %8l  *"%s%s*"  %c" '||m
  635.             OTHERWISE NOP
  636.           END
  637.           IF m~="" THEN CALL Shcmd('Echo >>tmp/tmplist "PLEASE USE THE RECURSIVE LIST-VERSION AS SELDOM AS POSSIBLE!*n"')
  638.           CALL Shcmd('Echo >>tmp/tmplist "Files and directories of path *"'||ConvertQuote(cdpath)||'*":*n"')
  639.           CALL Shcmd(l" "ConvertQuote(cdpath))
  640.           IF EXISTS('tmp/tmplist') THEN DO
  641.             CALL WRITELN('fp',"   -> Sending "wd" "cdpath)
  642.             SAY "Send "wd" "cdpath
  643.             CALL Shcmd('sendmail <tmp/tmplist -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'ConvertQuote(sendback)'" -s "'wd' 'ConvertQuote(cdpath)'" -raw')
  644.             CALL WriteLog("  "||wd cdpath||"  --  Length:" WORD(STATEF("tmp/tmplist"),2))
  645.             CALL DELETE('tmp/tmplist')
  646.           END
  647.           ELSE CALL WRITELN('fp',"### Error ocured. Could not send "wd" "cdpath)
  648.         END
  649.         ELSE DO
  650.           CALL WRITELN('fp','### Path does not exist! Could not send "'wd' 'cdpath'"')
  651.           CALL WRITELN('fp',"### Please use command PATHS for a list of available paths!")
  652.         END
  653.       END
  654. /***************
  655.  SHOWDIRS
  656. ***************/
  657.       WHEN wd="SHOWDIRS" THEN DO
  658.         IF cdpath~="?" & cdpathstern THEN DO
  659.           l='LIST >>tmp/tmplist DIRS ALL LFORMAT="    *"%s%s*""'
  660.           CALL DELETE('tmp/tmplist')
  661.           CALL Shcmd('Echo >tmp/tmplist "Subdirectories of path *"'||ConvertQuote(cdpath)||'*":*n"')
  662.           CALL Shcmd(l" "ConvertQuote(cdpath))
  663.           IF EXISTS('tmp/tmplist') THEN DO
  664.             CALL WRITELN('fp',"   -> Sending "wd" "cdpath)
  665.             SAY "Send "wd" "cdpath
  666.             CALL Shcmd('sendmail <tmp/tmplist -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'sendback'" -s "'wd' 'ConvertQuote(cdpath)'" -raw')
  667.             CALL WriteLog("  "||wd cdpath||"  --  Length:" WORD(STATEF("tmp/tmplist"),2))
  668.             CALL DELETE('tmp/tmplist')
  669.           END
  670.           ELSE CALL WRITELN('fp',"### Error ocured. Could not send "wd" "cdpath)
  671.         END
  672.         ELSE DO
  673.           IF ~cdpathstern THEN DO
  674.             CALL WRITELN('fp','### This path is not allowed to scan recursively. See command PATH!')
  675.           END
  676.           ELSE DO
  677.             CALL WRITELN('fp','### This path does not exist! Could not send "'wd' 'cdpath'"')
  678.             CALL WRITELN('fp',"### Please use command PATHS for a list of available paths!")
  679.           END
  680.         END
  681.       END
  682. /***************
  683.  GET
  684. ***************/
  685.       WHEN wd="GET" THEN DO
  686.         IF EXISTS(cdpath||l) & cdpath~="?" THEN DO
  687.           IF INDEX(sentget,UPPER(cdpath||l))=0 THEN DO
  688.             IF ~EXISTS("INOUT") THEN CALL MAKEDIR("INOUT")
  689.             IF LENGTH(SHOWDIR("INOUT","F"))~=0 THEN DO
  690.               CALL Shcmd('Delete INOUT/#?')
  691.             END
  692.  
  693.             IF ~OPEN('iout',"INOUT/OUT","W") THEN DO
  694.               errortxt='Could not open "INOUT/OUT"!'
  695.               SIGNAL LEAVE
  696.             END
  697.             x=STATEF(cdpath||l); k=WORD(x,6)
  698.             CALL WRITELN('iout','X-Name:    'l)
  699.             CALL WRITELN('iout','X-Path:    'cdpath)
  700.             CALL WRITELN('iout','X-Length:  'WORD(x,2)'   ( --> Length of the Original-File!)')
  701.             CALL WRITELN('iout','X-Date:    'TRANSLATE(DATE("",WORD(x,5),"I"),"-"," ")"  "RIGHT((k%60)//60,2,"0")":"RIGHT(k//60,2,"0")":"RIGHT(WORD(x,7)%50,2,"0"))
  702.             CALL WRITELN('iout',"X-Comment: "SUBWORD(x,8))
  703.             CALL WRITELN('iout',"X-Mode:    "mode)
  704.             CALL WRITELN('iout',"X-Session: "from" / "msid" / "date" / Level "ulevel)
  705.             CALL WRITELN('iout','')
  706.             CALL CLOSE('iout')
  707.  
  708.             IF EXISTS("config/"modegetscript) & modegetscript~="" THEN DO
  709.               CALL Shcmd('Execute config/'modegetscript '"'ConvertQuote(cdpath||l)'"' TRANSLATE(l,"_-"," "'"'))
  710.  
  711.               IF EXISTS("INOUT/OUT") THEN DO
  712.                 IF WORD(STATEF("INOUT/OUT"),2)>maxtransfer & maxtransfer~=0 THEN DO
  713.                   CALL WRITELN('fp',"### Sorry. "cdpath||l" is too long for transfer!")
  714.                   CALL WRITELN('fp',"### File is with "mode"-Mode longer than "maxtransfer" Bytes.")
  715.                 END
  716.                 ELSE DO
  717.                   CALL WRITELN('fp',"   -> Sending "cdpath||l)
  718.                   SAY "Send "cdpath||l
  719.                   CALL Shcmd('sendmail <INOUT/OUT -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'ConvertQuote(sendback)'" -s "GET 'ConvertQuote(cdpath||l)'"')
  720.                   CALL WriteLog("  GET" cdpath||l "  --  Length:" WORD(STATEF("INOUT/OUT"),2))
  721.                   sentget=sentget" "UPPER(cdpath||l)
  722.                 END
  723.               END
  724.               ELSE DO
  725.                 CALL WRITELN('fp',"### Some error occured while encoding. Could not send "cdpath||l)
  726.               END
  727.             END
  728.             ELSE CALL WRITELN('fp','### Script for mode 'mode': "config/'modeputscript'" does not exist!')
  729.           END
  730.           ELSE CALL WRITELN('fp',"### This file: "||cdpath||l||" has just been sent!")
  731.         END
  732.         ELSE DO
  733.           CALL WRITELN('fp',"### This file or path doesn't exist!")
  734.           CALL WRITELN('fp',"### - use some of the list-commands (see HELP) for a list of")
  735.           CALL WRITELN('fp',"###   availalble files in this path.")
  736.           CALL WRITELN('fp',"### - If error in CD-command before, use command PATHS!")
  737.           CALL WRITELN('fp',"### Could not send "||cdpath||l)
  738.         END
  739.         IF LENGTH(SHOWDIR("INOUT","F"))~=0 THEN DO
  740.           CALL Shcmd('Delete INOUT/#?')
  741.         END
  742.       END
  743. /***************
  744.  PUT
  745. ***************/
  746.       WHEN wd="PUT" THEN DO
  747.         IF xuplpath~="" & xname~="" & xcomment~="" & xlength~=0 THEN DO
  748.           IF RIGHT(xuplpath,1)~="/" THEN DO
  749.             IF RIGHT(xuplpath,1)~=":" THEN DO
  750.               xuplpath=xuplpath||"/"
  751.               CALL WRITELN('fp','   -> Add "/" to upload path, path is now "'xuplpath'"')
  752.             END
  753.           END
  754.  
  755.           CALL WRITELN('fp','   -> Request to upload a file')
  756.           CALL WRITELN('fp','      Path:        'xuplpath)
  757.           CALL WRITELN('fp','      Filename:    'xname)
  758.           CALL WRITELN('fp','      Comment:     'xcomment)
  759.           CALL WRITELN('fp','      Filelength:  'xlength)
  760.  
  761.           IF EXISTS("config/ftp-upload-paths.config") THEN DO
  762.             IF ~OPEN('pp',"config/ftp-upload-paths.config","R") THEN DO
  763.               errortxt='Could not open "config/ftp-upload-paths.config"!'
  764.               SIGNAL LEAVE
  765.             END
  766.             x=0
  767.             DO WHILE ~EOF('pp') & ~x
  768.               k=UPPER(STRIP(TRANSLATE(READLN('pp')," ","09"x),"B"))
  769.               IF LEFT(k,1)~="#" & k~="" THEN DO
  770.                 IF k=UPPER(xuplpath) THEN x=1
  771.               END
  772.             END
  773.             CALL CLOSE('pp')
  774.           END
  775.           ELSE DO
  776.             CALL WRITELN('fp','### Did not found file: "config/ftp-upload-paths.config"')
  777.             CALL WRITELN('fp','### Without this file uploading to this system is not allowed!')
  778.             xuplpath=""
  779.           END
  780.           IF ~x THEN DO
  781.             CALL WRITELN('fp',"### This path is not allowed! Command not executed!")
  782.             CALL WRITELN('fp','### Use the command "UPLOADPATHS" for a list of all guilty paths')
  783.             CALL WRITELN('fp','### for a upload!')
  784.             xuplpath=""
  785.           END
  786.           IF EXISTS(xuplpath) & xuplpath~="" THEN DO
  787.             x=""
  788.             DO WHILE EXISTS(xuplpath||xname||x)
  789.               IF x="" THEN x=0
  790.               x=x+1
  791.             END
  792.             xname=xname||x
  793.             IF EXISTS("config/"modeputscript) & modeputscript~="" THEN DO
  794.               IF ~EXISTS("INOUT") THEN CALL MAKEDIR("INOUT")
  795.               IF LENGTH(SHOWDIR("INOUT","F"))~=0 THEN DO
  796.                 CALL Shcmd('Delete INOUT/#?')
  797.               END
  798.               CALL Shcmd('Execute config/'modeputscript' "tmp/'mword'" "'ConvertQuote(xuplpath)'" "'ConvertQuote(xname)'" "'ConvertQuote(xcomment)'"')
  799.               IF EXISTS("INOUT/IN") THEN DO
  800.                 IF WORD(STATEF("INOUT/IN"),2)~=xlength THEN DO
  801.                   CALL WRITELN('fp','### WARNING: The length of the unpacked file')
  802.                   CALL WRITELN('fp','###          and your length are not matching!')
  803.                 END
  804.                 CALL Shcmd('Copy INOUT/IN TO "'ConvertQuote(xuplpath||xname)'" CLONE')
  805.                 CALL WRITELN('fp','   -> Copied file   -   operation complete!')
  806.                 CALL WriteLog("  PUT" xuplpath||xname "  --  Length:" WORD(STATEF("INOUT/IN"),2))
  807.               END
  808.               ELSE DO
  809.                 CALL WRITELN('fp','### There goes something wrong! Could not extract the file')
  810.                 CALL WRITELN('fp','### from your e-mail! Sorry, could not put File in.')
  811.               END
  812.             END
  813.             ELSE CALL WRITELN('fp','### A script for mode 'mode': "config/'modeputscript'" does not exist!')
  814.           END
  815.           ELSE DO
  816.             CALL WRITELN('fp','### This path "'xuplpath'" doesn not exist!')
  817.             CALL WRITELN('fp','### Although it is in the "config/ftp-upload-paths.config"')
  818.             CALL WRITELN('fp',"### it is not existing on the disk!")
  819.             CALL WRITELN('fp','### FTP-Postmaster of this system will be informed about this!')
  820.             CALL Shcmd('sendmail <tmp/'mword' -f "ftp-mail-daemon" -R "Saug-Buettel" -t "ftp-postmaster" -s "ERROR in ftp-upload-paths.config, please read logfile!" -raw')
  821.           END
  822.         END
  823.         ELSE DO
  824.           CALL WRITELN('fp','### One of this keywords:')
  825.           CALL WRITELN('fp','###     X-PATH:    ('xuplpath')')
  826.           CALL WRITELN('fp','###     X-NAME:    ('xname')')
  827.           CALL WRITELN('fp','###     X-COMMENT: ('xcomment')')
  828.           CALL WRITELN('fp','### or  X-LENGTH:  ('xlength')')
  829.           CALL WRITELN('fp','### have not been set to a value. If you want to upload')
  830.           CALL WRITELN('fp','### any file you must insert these keywords with a value!')
  831.         END
  832. /*        IF LENGTH(SHOWDIR("INOUT","F"))~=0 THEN DO
  833.           CALL Shcmd('Delete INOUT/#?')
  834.         END*/
  835.       END
  836. /*******************************************/
  837.       OTHERWISE NOP
  838.     END
  839.     cline=cline+1
  840.   END
  841.   CALL WRITELN('fp',"------------------------------------------------")
  842.  
  843.   IF cline<=2 THEN DO
  844.     CALL WRITELN('fp',"")
  845.     CALL WRITELN('fp',"### No user-command was given!                            ###")
  846.     CALL WRITELN('fp',"### Please use command HELPALL in Subject:-line or Body   ###")
  847.     CALL WRITELN('fp',"### to get the most important helpfiles from this daemon. ###")
  848.   END
  849.  
  850.  
  851.   CALL WRITELN('fp',"")
  852.   CALL WRITELN('fp',"-- End session: "DATE() TIME())
  853.  
  854.   CALL CLOSE('fp')
  855.   SAY "-------------------------------------------------"
  856.  
  857.   IF nologfile THEN SAY "NOLOGFILE is set! Send no logfile!"
  858.   ELSE DO
  859.     SAY "Send logfile..."
  860.     CALL Shcmd('sendmail <tmp/logfile -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'ConvertQuote(sendback)'" -s "LOGFILE" -raw')
  861.     CALL WriteLog("  SEND LOGFILE  --  Length:" WORD(STATEF("tmp/logfile"),2))
  862.   END
  863.  
  864.   CALL Shcmd('sendmail <tmp/logfile -f "ftp-mail-daemon" -R "Saug-Buettel" -t "ftp-postmaster" -s "LOGFILE" -raw')
  865.  
  866.   /* Logfile */
  867.   SAY "-------------------------------------------------"
  868.   IF ~OPEN("fp","tmp/logfile","R") THEN DO
  869.     errortxt='Could not open "logfile"'
  870.     SIGNAL LEAVE
  871.   END
  872.   DO WHILE ~EOF('fp')
  873.     SAY "** "READLN('fp')
  874.   END
  875.   CALL CLOSE('fp')
  876.  
  877.   CALL DELETE("tmp/logfile")
  878.   CALL DELETE("tmp/"mword)
  879. END
  880.  
  881. SAY "Ok, end... "DATE() TIME()" -> "TIME("E")"sec"
  882. SAY
  883. CALL CLOSE('sema')
  884. CALL DELETE("T:ftp-mail.semaphore")
  885.  
  886. EXIT
  887.  
  888.  
  889. /*****************************************************************/
  890. AddCommand:
  891.  PARSE ARG x
  892.  cmdline.cline=x
  893.  cline=cline+1
  894.  
  895.  IF cline>499 THEN DO
  896.    cmdline.cline="### Not more than 500 commands per mail allowed!"
  897.    cline=500
  898.  END
  899. RETURN
  900.  
  901.  
  902.  
  903. /*****************************************************************/
  904. ConvertQuote: PROCEDURE EXPOSE mword
  905.  PARSE ARG x
  906.  i=INDEX(x,'*')
  907.  DO WHILE INDEX(x,'*',i+(i=0))~=0
  908.    x=INSERT('*',x,INDEX(x,'*',i)-1)
  909.    i=INDEX(x,'*',i+1)+1
  910.  END
  911.  i=INDEX(x,'"')
  912.  DO WHILE INDEX(x,'"',i+(i=0))~=0
  913.    x=INSERT('*',x,INDEX(x,'"',i)-1)
  914.    i=INDEX(x,'"',i)+1
  915.  END
  916. RETURN x
  917.  
  918.  
  919. /*****************************************************************/
  920. Shcmd: PROCEDURE EXPOSE mword
  921.   PARSE ARG x
  922.   SAY " --> " x
  923.   OPTIONS FAILAT 50
  924.   ADDRESS COMMAND x
  925.   OPTIONS FAILAT 0
  926. RETURN 1
  927.  
  928.  
  929. /*****************************************************************/
  930. WriteLog: PROCEDURE EXPOSE mword
  931.   PARSE ARG x
  932.   x=DATE() TIME() x
  933.   IF EXISTS("tmp/time.LOG") THEN DO
  934.     IF ~OPEN('ln',"tmp/time.LOG","A") THEN DO
  935.       SAY 'ERROR: Could not write to "time.LOG"'
  936.       RETURN 0
  937.     END
  938.   END
  939.   ELSE DO
  940.     IF ~OPEN('ln',"tmp/time.LOG","W") THEN DO
  941.       SAY 'ERROR: Could not open for write time.LOG"'
  942.       RETURN 0
  943.     END
  944.   END
  945.  
  946.   CALL WRITELN('ln',x)
  947.   CALL CLOSE('ln')
  948. RETURN 1
  949.  
  950.  
  951. /*----------------------------------------------------------------------------
  952.   Converting of RFC address (singe lined) because of error in sendmail (see
  953.   history)!
  954.  
  955.   All Comments will be stripped, only the first address is guilty!
  956. ----------------------------------------------------------------------------*/
  957.  
  958. ParseRFCAddress: PROCEDURE
  959. PARSE ARG adr
  960.  
  961. ende=0
  962. quote=0
  963. comment=""
  964. DO adrptr=1 TO LENGTH(adr) WHILE ~ende
  965.   z=SUBSTR(adr,adrptr,1)
  966.  
  967.   IF quote THEN DO
  968.     SELECT
  969.      WHEN z=qstr THEN DO
  970.        quote=0
  971.        adr=DELSTR(adr,qbegin,adrptr-qbegin+1)
  972.        adrptr=qbegin-1
  973.      END
  974.      WHEN qstr="]" THEN NOP
  975.      OTHERWISE comment=comment||z
  976.     END
  977.   END
  978.   ELSE DO
  979.     SELECT
  980.      WHEN z="," THEN DO
  981.       adr=LEFT(adr,adrptr-1)
  982.       ende=1
  983.      END
  984.      WHEN z='"' THEN DO
  985.       quote=1
  986.       qstr='"'; qbegin=adrptr
  987.      END
  988.      WHEN z='(' THEN DO
  989.       quote=1
  990.       qstr=')'; qbegin=adrptr
  991.      END
  992.      WHEN z='[' THEN DO
  993.       quote=1
  994.       qstr=']'; qbegin=adrptr
  995.      END
  996.      OTHERWISE NOP
  997.     END
  998.   END
  999. END
  1000. IF quote THEN comment=""
  1001. comment=TRANSLATE(comment,"''","()")
  1002.  
  1003. /******* Commented out, no need to change address
  1004.  
  1005. PARSE VAR adr d1 "@" d2 " "
  1006.  
  1007. d1=STRIP(d1,"b")
  1008. d2=STRIP(d2,"b")
  1009.  
  1010. IF d2="" THEN DO
  1011.   SAY "Lokale Adresse"
  1012.   adr=d1
  1013. END
  1014. ELSE DO
  1015.   PARSE VAR adr com1 "<" dd1 "@" dd2 ">" com2
  1016.   IF dd1~="" & dd2~="" THEN DO
  1017.     d1=dd1; d2=dd2
  1018.     IF com1~="" THEN comment=comment||STRIP(com1,"B")
  1019.     IF com2~="" THEN comment=comment||STRIP(com2,"B")
  1020.   END
  1021.   adr=d1"@"d2
  1022. END
  1023. **********/
  1024.  
  1025. IF comment~="" THEN comment=" ("||comment||")"
  1026.  
  1027. RETURN adr||comment
  1028.  
  1029.  
  1030.  
  1031.  
  1032. /*----------------------------------------------------------------------------*/
  1033. Showsource:
  1034. PARSE ARG sig
  1035. SAY
  1036. SAY "----------------------------------------------"
  1037. DO j=sig-3 TO sig+2
  1038.   SAY SOURCELINE(j)
  1039.   IF j=sig THEN SAY "^^^^^^^^^^^^^^^^^^^^^^^^ Line, in which error occured!"
  1040. END
  1041. SAY "----------------------------------------------"
  1042. RETURN
  1043.  
  1044. Breakdown:
  1045.   IF SYMBOL("logfileflag")="VAR" THEN DO
  1046.     CALL WRITELN('fp',"")
  1047.     CALL WRITELN('fp',"------------------------------------------------")
  1048.     CALL WRITELN('fp',"ERRORTEXT: "errortxt)
  1049.     CALL WRITELN('fp',"")
  1050.     CALL WRITELN('fp',"-- End session with error - ftp-postmaster will be informed!...")
  1051.     CALL CLOSE('fp')
  1052.     SAY "Send logfile..."
  1053.     CALL Shcmd('sendmail <tmp/logfile -f "ftp-mail-daemon" -R "Saug-Buettel" -t "'ConvertQuote(sendback)'" -s "LOGFILE - Error occured!" -raw')
  1054.     CALL WriteLog("*** SEND ERROR-LOGFILE  --  Length:" WORD(STATEF("tmp/logfile"),2))
  1055.     SAY "Send logfile to ftp-postmaster..."
  1056.     SAY "END WITH ERROR: "DATE() TIME()" -> "TIME("E")"sec"
  1057.     CALL Shcmd('sendmail <tmp/logfile -f "ftp-mail-daemon" -R "Saug-Buettel" -t "ftp-postmaster" -s "ERROR!!!" -raw')
  1058.  
  1059.     SAY "-------------------------------------------------"
  1060.     IF ~OPEN("fp","tmp/logfile","R") THEN DO
  1061.       errortxt='Could not find "tmp/logfile"'
  1062.       SIGNAL LEAVE
  1063.     END
  1064.     DO WHILE ~EOF('fp')
  1065.       SAY "** "READLN('fp')
  1066.     END
  1067.     CALL CLOSE('fp')
  1068.  
  1069.     CALL DELETE("tmp/logfile")
  1070.     k=1
  1071.     DO WHILE EXISTS("tmp/errormail."k)
  1072.       k=k+1
  1073.     END
  1074.     CALL RENAME("tmp/"mword,"tmp/errormail."k)
  1075.   END
  1076.   ELSE DO
  1077.     SAY "Send warning to ftp-postmaster..."
  1078.     CALL Shcmd('sendmail <tmp/'mword' -f "ftp-mail-daemon" -R "Saug-Buettel" -t "ftp-postmaster" -s "ERROR!!!" -raw')
  1079.     CALL DELETE("tmp/"mword)
  1080.   END
  1081.   CALL CLOSE('sema')
  1082.   CALL DELETE("T:ftp-mail.semaphore")
  1083. RETURN
  1084.  
  1085.  
  1086. BREAK_C:
  1087. BREAK_D:
  1088. BREAK_E:
  1089. BREAK_F:
  1090. HALT:
  1091.  
  1092.   PARSE SOURCE x
  1093.   PARSE VAR x . . progname .
  1094.   SAY '###########################################'
  1095.   SAY '--> Program 'progname' stopped, Line: 'SIGL
  1096.   errortxt="Program stopped by ftp-postmaster."
  1097.   CALL ShowSource SIGL
  1098.   CALL Breakdown
  1099. EXIT 5
  1100.  
  1101. LEAVE:
  1102.   PARSE SOURCE x
  1103.   PARSE VAR x . . progname .
  1104.   SAY '###########################################'
  1105.   SAY 'ERROR: 'errortxt
  1106.   SAY
  1107.   SAY '       Abort Program 'progname', near line: 'SIGL
  1108.   CALL Breakdown
  1109. EXIT 10
  1110.  
  1111. NOVALUE:
  1112.   RC=39
  1113. SYNTAX:
  1114. ERROR:
  1115. IOERR:
  1116.   TRACE O
  1117.   PARSE SOURCE x
  1118.   PARSE VAR x . . progname .
  1119.   SAY '###########################################'
  1120.   SAY 'ERROR: Program Error 'RC' in 'progname
  1121.   SAY '       "'ERRORTEXT(RC)'"'
  1122.   SAY '       Line: 'SIGL
  1123.   errortxt='Program Error 'RC' in 'progname': 'ERRORTEXT(RC)
  1124.   CALL ShowSource SIGL
  1125.   CALL Breakdown
  1126. EXIT 20
  1127.  
  1128.